# $Id: utils.tcl 46 2007-09-09 16:46:20Z khomoutov $
# Utility procs.

proc my what {
	return [uplevel 1 namespace current]::$what
}

proc mycmd args {
	lset args 0 [uplevel 1 my [lindex $args 0]]
}

proc assert_required_args_present args {
	foreach {var opt} $args {
		upvar 1 $var v
		if {![info exists v]} {
			return -code error "required option missing: $opt"
		}
	}
}

proc normalize_flags {L args} {
	array set flags $args
	set out {}

	set skip 0
	foreach item $L {
		if {$skip} {
			lappend out $item
			set skip 0
		} elseif {[info exists flags($item)]} {
			lappend out $item $flags($item)
		} else {
			lappend out $item
			set skip 1
		}
	}

	set out
}

# Schelte Bron's implementation of [lassign] (appeared in Tcl 8.5)
# from http://wiki.tclers.tk/1530
# Note that Tclx also has [lassign] so we check for the existence of
# this command instead of checking the Tcl's version.
if {[info procs ::lassign] == ""} {
	proc ::lassign {values args} {
		uplevel 1 [list foreach $args [linsert $values end {}] break]
		lrange $values [llength $args] end
	}
}

# Returns a new list which is aqcuired by applying $body
# to each element of $list; variable named $_var in the
# caller's scope is set to the value of the current element
# of $list on each evaluation of $body.
# Richard Suchenwirth's implementation
# from http://wiki.tclers.tk/13920
proc lmap {_var list body} {
	upvar 1 $_var var
	set res {}
	foreach var $list {lappend res [uplevel 1 $body]}
	set res
}

# Name:
#   string_is_ip
# Purpose:
#   Checks whether its single parametr $addr is parseable as
#   an IP-address in dotted-decimal notation.
# Input:
#   addr -- string to check.
# Output:
#   True if the string is a valid IP address, false otherwise.
# Note:
#   Masks like /24 are not allowed.
proc string_is_ip addr {
	set octets [split $addr .]
	if {[llength $octets] != 4} { return 0 }
	foreach octet $octets {
		if {![string is integer $octet] || ($octet < 0 || $octet > 255)} {
			return 0
		}
	}
	return 1
}

# Name:
#   incr64
# Purpose:
#   Increments value of variable given by varName by a given integer
#   while ensuring the values of varName is wide int (64-bit).
#   This is mostly a workaround for pre-8.5 Tcl on which [incr]
#   "wraps around" the max positive signed 32-bit value when doing
#   [incr]. See http://wiki.tcl.tk/1476
# Input:
#   varName -- name of the variable to modify.
#   val -- value to increment by (default to 0).
# Output:
#   New value of the variable designated by varName.
# Side effects:
#   Value of the variable named varName is updated if $val isn't 0.
if {[package vsatisfies $tcl_patchLevel 8.5]} {
	interp alias {} incr64 {} incr
} else {
	proc incr64 {varName {val 0}} {
		upvar 1 $varName v
		set v [expr {wide($v) + $val}]
		set v
	}
}

# Removes $nth element (defaults to zeroth) of a list with name
# $listName in the caller's scope and returns value of that element.
proc lpop {listName {nth 0}} {
	upvar 1 $listName L
	set e [lindex $L $nth]
	set L [lreplace $L $nth $nth]
	set e
}

